home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / file.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-12-13  |  36.0 KB  |  1,338 lines
  1. IMPLEMENTATION MODULE file;
  2. __IMP_SWITCHES__
  3. #ifdef HM2
  4. #ifdef __LONG_WHOLE__
  5. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  6. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  7. #else
  8. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  9. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  10. #endif
  11. #endif
  12. (*****************************************************************************)
  13. (* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
  14. (* --------------------------------------------------------------------------*)
  15. (* 05-Dez-93, Holger Kleinschmidt                                            *)
  16. (*****************************************************************************)
  17.  
  18. VAL_INTRINSIC
  19. CAST_IMPORT
  20. PTR_ARITH_IMPORT
  21.  
  22. FROM SYSTEM IMPORT
  23. (* TYPE *) ADDRESS,
  24. (* PROC *) ADR;
  25.  
  26. FROM PORTAB IMPORT
  27. (* CONST*) NULL,
  28. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, WORDSET;
  29.  
  30. FROM MEMBLK IMPORT
  31. (* PROC *) memalloc, memdealloc;
  32.  
  33. FROM OSCALLS IMPORT
  34. (* PROC *) Fcreate, Fopen, Fclose, Fdelete, Fread, Fwrite, Fseek, Flock,
  35.            Fcntl, Fdup, Fforce, Pumask, Fchmod, Fattrib, Fchown, Fdatime,
  36.            Fpipe, Fxattr, Dgetdrv, Pgetuid, Pgetgid, Tgettime, Tgetdate,
  37.            Freadlink;
  38.  
  39. FROM ctype IMPORT
  40. (* PROC *) tocard;
  41.  
  42. FROM cstr IMPORT
  43. (* PROC *) strlen, AssignM2ToC;
  44.  
  45. FROM pSTRING IMPORT
  46. (* PROC *) SLEN, APPEND;
  47.  
  48. FROM types IMPORT
  49. (* CONST*) EOS, DDRVPOSTFIX, DDIRSEP,
  50. (* TYPE *) PathName, uidT, gidT, inoT, timeT, offT, sizeT, ssizeT, devT, pidT,
  51.            StrPtr, StrRange, timeCast;
  52.  
  53. IMPORT e;
  54.  
  55. FROM DosSystem IMPORT
  56. (* PROC *) DosVersion, FileLocking, MiNTVersion;
  57.  
  58. FROM DosSupport IMPORT
  59. (* CONST*) FINDALL, XDECR, DINCR, MinHandle, MaxHandle, getmask, setmask,
  60. (* TYPE *) DTA, FileAttributes, FileAttribute, DosFlags, DosFlag, HandleRange,
  61.            FileType,
  62. (* VAR  *) INODE, FD,
  63. (* PROC *) IsTerm, IsDosDevice, UnixToDos, FindFirst, IsExec, DosToUnix;
  64.  
  65. (*==========================================================================*)
  66.  
  67. CONST
  68.   EOKL  = LIC(0);
  69.   FSTAT = 00004600H;
  70.  
  71.   BLKSIZE  = 1024;
  72.   LBLKSIZE = 256; (* BLKSIZE DIV 4 *)
  73.  
  74.   STDPERM = modeT{sIRUSR,sIWUSR,sIRGRP,sIWGRP,sIROTH,sIWOTH};
  75.  
  76. TYPE
  77.   XATTR = RECORD
  78.     mode    : modeT;
  79.     index   : UNSIGNEDLONG;
  80.     dev     : UNSIGNEDWORD;
  81.     res1    : UNSIGNEDWORD;
  82.     nlink   : UNSIGNEDWORD;
  83.     uid     : UNSIGNEDWORD;
  84.     gid     : UNSIGNEDWORD;
  85.     size    : SIGNEDLONG;
  86.     blksize : SIGNEDLONG;
  87.     nblocks : SIGNEDLONG;
  88.     mtime   : WORDSET;
  89.     mdate   : WORDSET;
  90.     atime   : WORDSET;
  91.     adate   : WORDSET;
  92.     ctime   : WORDSET;
  93.     cdate   : WORDSET;
  94.     attr    : WORDSET;
  95.     res2    : SIGNEDWORD;
  96.     res3    : ARRAY [0..1] OF SIGNEDLONG;
  97.   END;
  98.  
  99. CONST
  100.   FRDLCK = 0;
  101.   FWRLCK = 1;
  102.   FUNLCK = 3;
  103.  
  104. TYPE
  105.   FLOCK = RECORD
  106.     type   : UNSIGNEDWORD;
  107.     whence : UNSIGNEDWORD;
  108.     start  : SIGNEDLONG;
  109.     len    : SIGNEDLONG;
  110.     pid    : SIGNEDWORD;
  111.   END;
  112.  
  113.  
  114. VAR
  115.   UMASK    : modeT;
  116.   zerofill : ARRAY [0..LBLKSIZE-1] OF UNSIGNEDLONG;
  117.   MiNT     : BOOLEAN;
  118.  
  119. VAR
  120.   DOSVersion : CARDINAL;
  121.  
  122. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  123.  
  124. PROCEDURE open ((* EIN/ -- *) REF file   : ARRAY OF CHAR;
  125.                 (* EIN/ -- *)     access : OpenMode;
  126.                 (* EIN/ -- *)     mode   : modeT         ): INTEGER;
  127.  
  128. VAR res     : INTEGER;
  129.     handle  : INTEGER;
  130.     fd      : HandleRange;
  131.     accMask : OpenMode;
  132.     attr    : WORDSET;
  133.     lres    : SIGNEDLONG;
  134.     done    : BOOLEAN;
  135.     tty     : BOOLEAN;
  136.     msize   : CARDINAL;
  137.     stack   : ADDRESS;
  138.     path0   : StrPtr;
  139.  
  140. BEGIN
  141.  (* Pfadname DOS-konform gestalten *)
  142.  msize := SLEN(file) + DINCR;
  143.  memalloc(VAL(sizeT,msize), stack, path0);
  144.  UnixToDos(file, msize - DINCR, VAL(StrRange,msize), path0, tty, done);
  145.  IF NOT done THEN
  146.    memdealloc(stack);
  147.    RETURN(MINHANDLE-1);
  148.  END;
  149.  
  150.  (* Flags ermitteln, die das OS selbst auswerten kann *)
  151.  IF MiNT THEN
  152.    accMask := oACCMODE + OpenMode{oAPPEND, oNONBLOCK, oCREAT, oTRUNC, oEXCL};
  153.  ELSE
  154.    accMask := oACCMODE;
  155.  END;
  156.  
  157.  IF Fattrib(path0, 0, 0, attr) THEN
  158.    (* Datei existiert bereits *)
  159.    IF OpenMode{oCREAT, oEXCL} <= access THEN
  160.      (* Exklusiver Zugriff nicht moeglich *)
  161.      handle := e.EEXIST;
  162.    ELSE
  163.      (* Datei im angegebenen Modus oeffnen *)
  164.      done := Fopen(path0, access * accMask, handle);
  165.      IF NOT MiNT AND (oTRUNC IN access) AND (handle >= 0) THEN
  166.        (* TOS kann oTRUNC bei einer normalen Datei (kein Geraet) nicht
  167.         * selbst behandeln.
  168.         *)
  169.        done := Fclose(handle, res);
  170.        IF access * oACCMODE = oRDONLY THEN
  171.          (* Wenn die Datei nur zum Lesen geoeffnet wurde, ist kein
  172.           * Kuerzen moeglich.
  173.           *)
  174.          handle := e.EACCES;
  175.        ELSE
  176.          (* Sonst wird die Datei neu erzeugt und mit dem gewuenschten
  177.           * Zugriffsmodus geoeffnet. Die alten Dateiattribute werden
  178.           * uebernommen (auch faHIDDEN und faSYSTEM).
  179.           *
  180.           * Unter alten TOS-Versionen wurde nach einem 'Fcreate' eine
  181.           * alte Datei gleichen Namens manchmal nicht geloescht, deswegen
  182.           * zuerst das 'Fdelete'.
  183.           *)
  184.          done :=     Fdelete(path0, handle)
  185.                  AND Fcreate(path0, 0, handle)
  186.                  AND Fclose(handle, handle)
  187.                  AND Fopen(path0, access * accMask, handle)
  188.                  AND Fattrib(path0, 1, attr, attr);
  189.        END;
  190.      END;
  191.    END;
  192.  ELSIF oCREAT IN access THEN
  193.    (* Datei soll mit den angegebenen Attributen neu angelegt werden *)
  194.    mode := mode - UMASK;
  195.    (* Auch fuer MiNT, da 'Fchmod' die Prozessmaske nicht beruecksichtigt *)
  196.    IF MiNT THEN
  197.      (* oCREAT wird von MiNT erledigt *)
  198.      done :=     Fopen(path0, access * accMask, handle)
  199.              AND Fchmod(path0, mode, res);
  200.    ELSE
  201.      (* Sonst wird die Datei neu erzeugt und mit dem gewuenschten
  202.       * Zugriffsmodus geoeffnet. Fuer die Attribute der neuen Datei
  203.       * wird die Prozessmaske beruecksichtigt.
  204.       *)
  205.      IF sIWUSR IN mode THEN
  206.        attr := WORDSET{};
  207.      ELSE
  208.        attr := CAST(WORDSET,FileAttribute{faRDONLY});
  209.      END;
  210.      done :=     Fcreate(path0, 0, handle)
  211.              AND Fclose(handle, handle)
  212.              AND Fopen(path0, access * accMask, handle)
  213.              AND Fattrib(path0, 1, attr, attr);
  214.    END;
  215.  ELSE
  216.    (* Datei existiert nicht und soll auch nicht neu angelegt werden *)
  217.    handle := e.ENOENT;
  218.  END;
  219.  
  220.  memdealloc(stack);
  221.  IF handle < MINHANDLE THEN
  222.    e.errno := handle;
  223.    RETURN(MINHANDLE-1);
  224.  END;
  225.  
  226.  tty := IsTerm(handle);
  227.  
  228.  IF MiNT THEN
  229.    (* Die kleinste Kennung, die 'Fopen' fuer eine Datei liefert,
  230.     * ist auch unter MiNT gleich 6. Falls aber eine kleinere Kennung
  231.     * frei ist, kann diese stattdessen benutzt werden. Also wird
  232.     * eine weitere Kennung fuer diese Datei erzeugt, und die kleinere
  233.     * der beiden verwendet, waehrend die andere wieder freigegeben wird.
  234.     * Eine andere Kennung veraendert nicht das Ergebnis von "IsTerm"!
  235.     *)
  236.    IF Fcntl(handle, 0, ORD(fDUPFD), lres) THEN
  237.      res := INT(lres);
  238.      IF res < handle THEN
  239.        (* Eine kleinere Kennung ist frei, also diese nehmen und die
  240.         * andere freigeben.
  241.         *)
  242.        done   := Fclose(handle, handle);
  243.        handle := res;
  244.      ELSE
  245.        (* Die von 'Fopen' gelieferte Kennung ist bereits die kleinste
  246.         * freie gewesen, also die neue wieder freigeben.
  247.         *)
  248.        done := Fclose(res, res);
  249.      END;
  250.    END;
  251.  
  252.    (* MiNT schliesst normalerweise alle Dateikennungen, ausser den
  253.     * Standardkanaelen, bei Ausfuehren eines 'Pexec'.
  254.     *)
  255.    done := Fcntl(handle, 0, ORD(fGETFD), lres);
  256.    IF ODD(lres) THEN
  257.      DEC(lres);
  258.    END;
  259.    done := Fcntl(handle, lres, ORD(fSETFD), lres);
  260.    IF tty THEN
  261.      FD[VAL(HandleRange,handle)].ftype := istty;
  262.      IF NOT (oNOCTTY IN access) AND NOT IsTerm(-1) THEN
  263.        (* Wenn Handle -1 (aktuelles Kontrollterminal) kein Terminal ist
  264.         * (auf /dev/null umgelenkt), aber die geoeffnete Datei, wird die neu
  265.         * geoffnete Datei zum Kontrollterminal, ausser, sowas ist unerwuenscht.
  266.         * (Kann nur unter MiNT auftreten.)
  267.         *)
  268.        done := Fforce(-1, handle, res);
  269.      END;
  270.    ELSE
  271.      FD[VAL(HandleRange,handle)].ftype := notty;
  272.    END;
  273.  ELSE
  274.    WITH FD[VAL(HandleRange,handle)] DO
  275.      cloex := FALSE;
  276.      IF tty THEN
  277.        ftype := istty;
  278.      ELSE
  279.        ftype := notty;
  280.      END;
  281.      flags := CAST(DosFlag,access);
  282.    END;
  283.  END; (* IF MiNT *)
  284.  RETURN(handle);
  285. END open;
  286.  
  287. (*--------------------------------------------------------------------------*)
  288.  
  289. PROCEDURE creat ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  290.                  (* EIN/ -- *)     mode : modeT         ): INTEGER;
  291.  
  292. BEGIN
  293.  RETURN(open(file, oWRONLY + OpenMode{oCREAT,oTRUNC}, mode));
  294. END creat;
  295.  
  296. (*--------------------------------------------------------------------------*)
  297.  
  298. PROCEDURE fcntl ((* EIN/ -- *)     h   : INTEGER;
  299.                  (* EIN/ -- *)     cmd : FcntlCmd;
  300.                  (* EIN/AUS *) VAR arg : FcntlArg ): INTEGER;
  301.  
  302. VAR done : BOOLEAN;
  303.     res  : INTEGER;
  304.     lres : SIGNEDLONG;
  305.     lock : FLOCK;
  306.     par  : SIGNEDLONG;
  307.  
  308. BEGIN
  309.  IF MiNT THEN
  310.    WITH arg DO
  311.      CASE cmd OF
  312.        fDUPFD  : par := VAL(SIGNEDLONG,handle);
  313.       |fSETFD  : par := VAL(SIGNEDLONG,CAST(UNSIGNEDWORD,fdflags));
  314.       |fSETFL  : par := VAL(SIGNEDLONG,CAST(UNSIGNEDWORD,mode));
  315.       |fGETLK,
  316.        fSETLK,
  317.        fSETLKW : WITH flock DO WITH lock DO
  318.                    IF lType <= fWRLCK THEN
  319.                      type := VAL(UNSIGNEDWORD,lType);
  320.                    ELSE
  321.                      type := FUNLCK;
  322.                    END;
  323.                    whence := VAL(UNSIGNEDWORD,lWhence);
  324.                    start  := VAL(SIGNEDLONG,lStart);
  325.                    len    := VAL(SIGNEDLONG,lLen);
  326.                    pid    := VAL(SIGNEDWORD,lPid);
  327.                  END; END;
  328.                  par := CAST(SIGNEDLONG,ADR(lock));
  329.      ELSE (* fGETFD, fGETFL *)
  330.        par := 0;
  331.      END;
  332.      IF Fcntl(h, par, ORD(cmd), lres) THEN
  333.        CASE cmd OF
  334.          fDUPFD  : handle := INT(lres);
  335.                    FD[VAL(HandleRange,handle)] := FD[VAL(HandleRange,h)];
  336.         |fGETFD  : fdflags := CAST(FDFlag,VAL(UNSIGNEDWORD,lres));
  337.         |fGETFL  : mode    := CAST(OpenMode,VAL(UNSIGNEDWORD,lres));
  338.         |fGETLK,
  339.          fSETLK,
  340.          fSETLKW : WITH flock DO WITH lock DO
  341.                      IF type <= FWRLCK THEN
  342.                        lType := VAL(LockType,type);
  343.                      ELSE
  344.                        lType := fUNLCK;
  345.                      END;
  346.                      lWhence := VAL(SeekMode,whence);
  347.                      lStart  := VAL(offT,start);
  348.                      lLen    := VAL(offT,len);
  349.                      lPid    := VAL(pidT,pid);
  350.                    END; END;
  351.        ELSE
  352.          (* fSETFD, fSETFL *)
  353.        END;
  354.        RETURN(0);
  355.      ELSE
  356.        e.errno := INT(lres);
  357.        IF (e.errno = e.eLOCKED) OR (e.errno = e.eNSLOCK) THEN
  358.          e.errno := e.EACCES;
  359.        END;
  360.        RETURN(-1);
  361.      END;
  362.    END; (* WITH arg *)
  363.  ELSE (* NOT MiNT *)
  364.    IF (h<MinHandle) OR (h>MaxHandle) THEN
  365.      e.errno := e.EBADF;
  366.      RETURN(-1);
  367.    END;
  368.    WITH arg DO
  369.      CASE cmd OF
  370.        fSETFD : FD[VAL(HandleRange,h)].cloex := FdCloExec IN fdflags;
  371.       |fGETFD : IF FD[VAL(HandleRange,h)].cloex THEN
  372.                   fdflags := FDFlag{FdCloExec};
  373.                 ELSE
  374.                   fdflags := FDFlag{};
  375.                 END;
  376.       |fSETFL : WITH FD[VAL(HandleRange,h)] DO
  377.                   flags := flags * setmask + (CAST(DosFlag,mode) - setmask);
  378.                 END;
  379.       |fGETFL : mode := CAST(OpenMode,FD[VAL(HandleRange,h)].flags * getmask);
  380.       |fDUPFD : IF Fdup(h, handle) THEN
  381.                   FD[VAL(HandleRange,handle)]       := FD[VAL(HandleRange,h)];
  382.                   FD[VAL(HandleRange,handle)].cloex := FALSE;
  383.                 ELSE
  384.                   e.errno := handle;
  385.                   RETURN(-1);
  386.                 END;
  387.       |fSETLK : WITH flock DO
  388.                   res := e.EINVAL;
  389.                   IF    NOT FileLocking()
  390.                      OR (lType = fRDLCK) OR (lWhence <> SeekSet)
  391.                      OR NOT Flock(h, ORD(lType), lStart, lLen, res)
  392.                   THEN
  393.                     IF (res = e.eLOCKED) OR (res = e.eNSLOCK) THEN
  394.                       e.errno := e.EACCES;
  395.                     ELSE
  396.                       e.errno := res;
  397.                     END;
  398.                     RETURN(-1);
  399.                   END;
  400.                 END;
  401.      ELSE
  402.        e.errno := e.EINVAL;
  403.        RETURN(-1);
  404.      END; (* CASE *)
  405.      RETURN(0);
  406.    END; (* WITH arg *)
  407.  END; (* IF MiNT *)
  408. END fcntl;
  409.  
  410. (*--------------------------------------------------------------------------*)
  411.  
  412. PROCEDURE close ((* EIN/ -- *) h : INTEGER ): INTEGER;
  413.  
  414. VAR res : INTEGER;
  415.  
  416. BEGIN
  417.  IF (h<MinHandle) OR (h>MaxHandle) THEN
  418.    e.errno := e.EBADF;
  419.    RETURN(-1);
  420.  END;
  421.  IF Fclose(h, res) THEN
  422.    WITH FD[VAL(HandleRange,h)] DO
  423.      ftype := unknown;
  424.      cloex := FALSE;
  425.    END;
  426.    RETURN(0);
  427.  ELSE
  428.    e.errno := res;
  429.    RETURN(-1);
  430.  END;
  431. END close;
  432.  
  433. (*--------------------------------------------------------------------------*)
  434.  
  435. PROCEDURE read ((* EIN/ -- *) h   : INTEGER;
  436.                 (* EIN/ -- *) buf : ADDRESS;
  437.                 (* EIN/ -- *) len : sizeT   ): ssizeT;
  438.  
  439. VAR lres : SIGNEDLONG;
  440.  
  441. BEGIN
  442.  IF Fread(h, VAL(SIGNEDLONG,len), buf, lres) THEN
  443.    RETURN(VAL(ssizeT,lres));
  444.  ELSE
  445.    e.errno := INT(lres);
  446.    RETURN(-1);
  447.  END;
  448. END read;
  449.  
  450. (*--------------------------------------------------------------------------*)
  451.  
  452. PROCEDURE write ((* EIN/ -- *) h   : INTEGER;
  453.                  (* EIN/ -- *) buf : ADDRESS;
  454.                  (* EIN/ -- *) len : sizeT   ): ssizeT;
  455.  
  456. VAR lres : SIGNEDLONG;
  457.  
  458. BEGIN
  459.  IF NOT MiNT THEN
  460.    IF (h<MinHandle) OR (h>MaxHandle) THEN
  461.      e.errno := e.EBADF;
  462.      RETURN(-1);
  463.    ELSIF append IN FD[VAL(HandleRange,h)].flags THEN
  464.      IF NOT Fseek(0, h, ORD(SeekEnd), lres) THEN
  465.        e.errno := INT(lres);
  466.        RETURN(-1);
  467.      END;
  468.    END;
  469.  END;
  470.  IF Fwrite(h, VAL(SIGNEDLONG,len), buf, lres) THEN
  471.    RETURN(VAL(ssizeT,lres));
  472.  ELSE
  473.    e.errno := INT(lres);
  474.    RETURN(-1);
  475.  END;
  476. END write;
  477.  
  478. (*--------------------------------------------------------------------------*)
  479.  
  480. PROCEDURE lseek ((* EIN/ -- *) h    : INTEGER;
  481.                  (* EIN/ -- *) off  : offT;
  482.                  (* EIN/ -- *) mode : SeekMode ): offT;
  483.  
  484. CONST ERANGEL = LIC(-64);
  485.       EACCDNL = LIC(-36);
  486.  
  487. VAR lres   : SIGNEDLONG;
  488.     curPos : SIGNEDLONG;
  489.     newPos : SIGNEDLONG;
  490.     len    : SIGNEDLONG;
  491.     done   : BOOLEAN;
  492.  
  493. BEGIN
  494.  len := VAL(SIGNEDLONG,off);
  495.  
  496.  IF len <= LIC(0) THEN
  497.    (* Datei braucht nicht verlaengert zu werden *)
  498.    IF Fseek(len, h, ORD(mode), lres) THEN
  499.      RETURN(VAL(offT,lres));
  500.    ELSIF MiNT AND (lres = EACCDNL) THEN
  501.      e.errno := e.ESPIPE;
  502.    ELSE
  503.      e.errno := INT(lres);
  504.    END;
  505.    RETURN(-1);
  506.  END;
  507.  
  508.  (* Augenblickliche Position feststellen, bei 'SeekEnd' gleich
  509.   * ans Ende der Datei.
  510.   *)
  511.  IF mode = SeekEnd THEN
  512.    done := Fseek(0, h, ORD(SeekEnd), curPos);
  513.  ELSE
  514.    done := Fseek(0, h, ORD(SeekCur), curPos);
  515.  END;
  516.  IF NOT done THEN
  517.    IF MiNT AND (curPos = EACCDNL) THEN
  518.      e.errno := e.ESPIPE;
  519.    ELSE
  520.      e.errno := INT(curPos);
  521.    END;
  522.    RETURN(-1);
  523.  END;
  524.  
  525.  (* gewuenschte Position berechnen. 'SeekEnd' und 'SeekCur' koennen
  526.   * gleichbehandelt werden, da der Zeiger bei 'SeekEnd' schon am
  527.   * Ende der Datei steht.
  528.   *)
  529.  IF mode = SeekSet THEN
  530.    newPos := len;
  531.  ELSE
  532.    newPos := curPos + len;
  533.  END;
  534.  
  535.  (* Es kann sein (ist auch meistens der Fall), dass die gewuenschte
  536.   * Position innerhalb der bestehenden Datei liegt. Deswegen wird zuerst
  537.   * versucht, die gewuenschte Position direkt anzufahren. Wenn dabei ein
  538.   * ``Range-Fehler'' auftritt, muss die Datei verlaengert werden.
  539.   * Ein ``Range-Fehler'' tritt nicht auf, wenn das Dateisystem
  540.   * (z.B. MinixFS) ein Fseek hinter das Dateiende selbst verwaltet.
  541.   *)
  542.  done := Fseek(len, h, ORD(mode), curPos);
  543.  IF curPos = newPos THEN
  544.    RETURN(VAL(offT,curPos));
  545.  ELSIF NOT done AND (curPos <> ERANGEL) THEN
  546.    e.errno := INT(curPos);
  547.    RETURN(-1);
  548.  END;
  549.  
  550.  
  551.  done := Fseek(0, h, ORD(SeekEnd), curPos);
  552.  
  553.  (* Solange Nullbytes schreiben, bis die Datei auf die gewuenschte
  554.   * Laenge gebracht ist.
  555.   *)
  556.  REPEAT
  557.    len := newPos - curPos;
  558.    IF  len > VAL(SIGNEDLONG,BLKSIZE)  THEN
  559.      len := VAL(SIGNEDLONG,BLKSIZE);
  560.    END;
  561.    done := Fwrite(h, len, ADR(zerofill), lres);
  562.    IF  lres <> len  THEN
  563.      IF done THEN
  564.        RETURN(VAL(offT,curPos + lres));
  565.      ELSE
  566.        e.errno := INT(lres);
  567.        RETURN(VAL(offT,curPos));
  568.      END;
  569.    END;
  570.    INC(curPos, len);
  571.  UNTIL curPos >= newPos;
  572.  RETURN(VAL(offT,curPos));
  573. END lseek;
  574.  
  575. (*--------------------------------------------------------------------------*)
  576.  
  577. PROCEDURE ftruncate ((* EIN/ -- *) h   : INTEGER;
  578.                      (* EIN/ -- *) len : offT    ): INTEGER;
  579.  
  580. (* MinixFS 0.60pl6 funktioniert nur, wenn die Datei mit oWRONLY
  581.    geoeffnet wurde.
  582.  *)
  583. CONST FTRUNCATE = 4604H; (* ('F'<<8)|4 *)
  584.  
  585. VAR lres : SIGNEDLONG;
  586.  
  587. BEGIN
  588.  IF MiNT THEN
  589.    IF Fcntl(h, ADR(len), FTRUNCATE, lres) THEN
  590.      RETURN(0);
  591.    ELSE
  592.      e.errno := INT(lres);
  593.      RETURN(-1);
  594.    END;
  595.  ELSE
  596.    e.errno := e.ENOSYS;
  597.    RETURN(-1);
  598.  END;
  599. END ftruncate;
  600.  
  601. (*--------------------------------------------------------------------------*)
  602.  
  603. PROCEDURE dup ((* EIN/ -- *) h : INTEGER ): INTEGER;
  604.  
  605. VAR lres : SIGNEDLONG;
  606.     done : BOOLEAN;
  607.     newh : INTEGER;
  608.  
  609. BEGIN
  610.  IF MiNT THEN
  611.    done := Fcntl(h, 0, ORD(fDUPFD), lres);
  612.    newh := INT(lres);
  613.    IF done THEN
  614.      (* 'FdCloExec'-Flag loeschen, falls gesetzt *)
  615.      done := Fcntl(newh, 0, ORD(fGETFD), lres);
  616.      IF ODD(lres) THEN
  617.        DEC(lres);
  618.      END;
  619.      done := Fcntl(newh, lres, ORD(fSETFD), lres);
  620.      FD[VAL(HandleRange,newh)].ftype := FD[VAL(HandleRange,h)].ftype;
  621.      RETURN(newh);
  622.    ELSE
  623.      e.errno := newh;
  624.      RETURN(-1);
  625.    END;
  626.  ELSE
  627.    IF (h<MinHandle) OR (h>MaxHandle) THEN
  628.      e.errno := e.EBADF;
  629.      RETURN(-1);
  630.    END;
  631.    IF Fdup(h, newh) THEN
  632.      FD[VAL(HandleRange,newh)]       := FD[VAL(HandleRange,h)];
  633.      FD[VAL(HandleRange,newh)].cloex := FALSE;
  634.      RETURN(newh);
  635.    ELSE
  636.      e.errno := newh;
  637.      RETURN(-1);
  638.    END;
  639.  END;
  640. END dup;
  641.  
  642. (*--------------------------------------------------------------------------*)
  643.  
  644. PROCEDURE dup2 ((* EIN/ -- *) oldh : INTEGER;
  645.                 (* EIN/ -- *) newh : INTEGER ): INTEGER;
  646.  
  647. VAR res  : INTEGER;
  648.     lres : SIGNEDLONG;
  649.     void : BOOLEAN;
  650.  
  651. BEGIN
  652.  IF oldh = newh THEN
  653.    RETURN(newh);
  654.  END;
  655.  (* Das Schliessen eines Standardkanals macht eine vorherige
  656.   * Umleitung rueckgaengig. Ist aber erst seit dem GEMDOS des TOS 1.04
  657.   * anwendbar.
  658.   *)
  659.  IF DOSVersion >= 1500H THEN
  660.    void := Fclose(newh, res);
  661.  END;
  662.  
  663.  IF Fforce(newh, oldh, res) THEN
  664.    IF MiNT THEN
  665.      (* 'FdCloExec'-Flag loeschen, falls gesetzt *)
  666.      void := Fcntl(newh, 0, ORD(fGETFD), lres);
  667.      IF ODD(lres) THEN
  668.        DEC(lres);
  669.      END;
  670.      void := Fcntl(newh, lres, ORD(fSETFD), lres);
  671.      FD[VAL(HandleRange,newh)].ftype := FD[VAL(HandleRange,oldh)].ftype;
  672.    ELSE
  673.      IF (newh<MinHandle) OR (newh>MaxHandle) THEN
  674.        e.errno := e.EBADF;
  675.        RETURN(-1);
  676.      END;
  677.      FD[VAL(HandleRange,newh)]       := FD[VAL(HandleRange,oldh)];
  678.      FD[VAL(HandleRange,newh)].cloex := FALSE;
  679.    END;
  680.    RETURN(newh);
  681.  ELSE
  682.    e.errno := res;
  683.    RETURN(-1);
  684.  END;
  685. END dup2;
  686.  
  687. (*--------------------------------------------------------------------------*)
  688.  
  689. PROCEDURE umask ((* EIN/ -- *) excl : modeT ): modeT;
  690.  
  691. VAR oldmask : modeT;
  692.  
  693. BEGIN
  694.  oldmask := UMASK;
  695.  UMASK   := excl;
  696.  IF MiNT THEN
  697.    RETURN(CAST(modeT,Pumask(excl)));
  698.  ELSE
  699.    RETURN(oldmask);
  700.  END;
  701. END umask;
  702.  
  703. (*---------------------------------------------------------------------------*)
  704.  
  705. PROCEDURE chmod ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  706.                  (* EIN/ -- *)     mode : modeT         ): INTEGER;
  707.  
  708. VAR         res    : INTEGER;
  709.             dot    : BOOLEAN;
  710.             done   : BOOLEAN;
  711.             dta    : DTA;
  712.     __REG__ attr   : FileAttribute;
  713.             old    : WORDSET;
  714.             stack  : ADDRESS;
  715.             msize  : CARDINAL;
  716.             path0  : StrPtr;
  717.  
  718. BEGIN
  719.  msize := SLEN(file) + DINCR;
  720.  memalloc(VAL(sizeT,msize), stack, path0);
  721.  UnixToDos(file, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  722.  IF NOT done THEN
  723.    memdealloc(stack);
  724.    RETURN(-1);
  725.  END;
  726.  
  727.  IF MiNT THEN
  728.    IF Fchmod(path0, mode, res) THEN
  729.      res := 0;
  730.    ELSE
  731.      e.errno := res;
  732.      res     := -1;
  733.    END;
  734.    memdealloc(stack);
  735.    RETURN(res);
  736.  ELSIF FindFirst(path0, FINDALL, dta, res) THEN
  737.    attr := dta.attr;
  738.    IF faSUBDIR IN attr THEN
  739.      (* Verzeichnisse in Ruhe lassen (duerfen keine weiteren Attribute haben)*)
  740.      memdealloc(stack);
  741.      RETURN(0);
  742.    END;
  743.    IF faCHANGED IN attr THEN
  744.      (* Archivbit nicht veraendern *)
  745.      attr := FileAttribute{faRDONLY, faCHANGED};
  746.    ELSE
  747.      attr := FileAttribute{faRDONLY};
  748.    END;
  749.    IF sIWUSR IN mode THEN
  750.      EXCL(attr, faRDONLY);
  751.    END;
  752.    IF Fattrib(path0, 1, attr, old) THEN
  753.      res := 0;
  754.    ELSE
  755.      e.errno := INT(CAST(SIGNEDWORD,old));
  756.      res     := -1;
  757.    END;
  758.  ELSE
  759.    e.errno := res;
  760.    res     := -1;
  761.  END;
  762.  memdealloc(stack);
  763.  RETURN(res);
  764. END chmod;
  765.  
  766. (*--------------------------------------------------------------------------*)
  767.  
  768. PROCEDURE chown ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  769.                  (* EIN/ -- *)     uid  : uidT;
  770.                  (* EIN/ -- *)     gid  : gidT          ): INTEGER;
  771.  
  772. VAR res    : INTEGER;
  773.     dot    : BOOLEAN;
  774.     done   : BOOLEAN;
  775.     stack  : ADDRESS;
  776.     msize  : CARDINAL;
  777.     path0  : StrPtr;
  778.  
  779. BEGIN
  780.  IF MiNT THEN
  781.    msize := SLEN(file) + DINCR;
  782.    memalloc(VAL(sizeT,msize), stack, path0);
  783.    UnixToDos(file, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  784.    IF NOT done THEN
  785.      res := -1;
  786.    ELSE
  787.      IF Fchown(path0, uid, gid, res) THEN
  788.        res := 0;
  789.      ELSE
  790.        e.errno := res;
  791.        res     := -1;
  792.      END;
  793.    END;
  794.    memdealloc(stack);
  795.    RETURN(res);
  796.  ELSIF (uid = 0) AND (gid = 0) THEN
  797.    RETURN(0);
  798.  ELSE
  799.    e.errno := e.EINVAL;
  800.    RETURN(-1);
  801.  END;
  802. END chown;
  803.  
  804. (*--------------------------------------------------------------------------*)
  805.  
  806. PROCEDURE utime ((* EIN/ -- *) REF file  : ARRAY OF CHAR;
  807.                  (* EIN/ -- *)     times : UTimeBuf      ): INTEGER;
  808.  
  809. CONST FUTIME = 4603H; (* ('F'<<8)|3 *)
  810.  
  811. VAR lres   : SIGNEDLONG;
  812.     hndl   : INTEGER;
  813.     void   : BOOLEAN;
  814.     done   : BOOLEAN;
  815.     tmp    : WORDSET;
  816.     stack  : ADDRESS;
  817.     tptr   : ADDRESS;
  818.     msize  : CARDINAL;
  819.     path0  : StrPtr;
  820.     tc     : timeCast;
  821.  
  822. BEGIN
  823.  msize := SLEN(file) + DINCR;
  824.  memalloc(VAL(sizeT,msize), stack, path0);
  825.  UnixToDos(file, msize - DINCR, VAL(StrRange,msize), path0, void, done);
  826.  IF NOT done THEN
  827.    memdealloc(stack);
  828.    RETURN(-1);
  829.  END;
  830.  
  831.  tptr := ADR(times);
  832.  WITH times DO
  833.    IF modtime = VAL(UNSIGNEDLONG,0) THEN
  834.      tptr    := NULL;
  835.      tc.date := Tgetdate();
  836.      tc.time := Tgettime();
  837.      modtime := tc.cmp;
  838.      actime  := tc.cmp;
  839.    END;
  840.    (* bei 'timeT' sind 'date' und 'time' vertauscht *)
  841.    tc.cmp  := modtime;
  842.    tmp     := tc.date;
  843.    tc.date := tc.time;
  844.    tc.time := tmp;
  845.    modtime := tc.cmp;
  846.    tc.cmp  := actime;
  847.    tmp     := tc.date;
  848.    tc.date := tc.time;
  849.    tc.time := tmp;
  850.    actime  := tc.cmp;
  851.  
  852.    done := Fopen(path0, oWRONLY, hndl);
  853.    IF done THEN
  854.      IF NOT (MiNT AND Fcntl(hndl, tptr, FUTIME, lres)) THEN
  855.        Fdatime(ADR(modtime), hndl, 1);
  856.      END;
  857.      void := Fclose(hndl, hndl);
  858.    ELSIF hndl = e.eFILNF THEN
  859.      void := Fattrib(path0, 0, 0, tmp);
  860.      IF faSUBDIR IN CAST(FileAttribute,tmp) THEN
  861.        (* Verzeichnisse in Ruhe lassen *)
  862.        done := TRUE;
  863.      END;
  864.    END;
  865.  END; (* WITH *)
  866.  IF done THEN
  867.    hndl := 0;
  868.  ELSE
  869.    e.errno := hndl;
  870.    hndl    := -1;
  871.  END;
  872.  memdealloc(stack);
  873.  RETURN(hndl);
  874. END utime;
  875.  
  876. (*---------------------------------------------------------------------------*)
  877.  
  878. PROCEDURE pipe ((* -- /AUS *) VAR ph : PipeBuf ): INTEGER;
  879.  
  880. VAR handle : ARRAY [0..1] OF SIGNEDWORD;
  881.     res    : INTEGER;
  882.  
  883. BEGIN
  884.  ph.readh  := 0;
  885.  ph.writeh := 0;
  886.  IF MiNT THEN
  887.    IF Fpipe(ADR(handle), res) THEN
  888.      ph.readh  := INT(handle[0]);
  889.      ph.writeh := INT(handle[1]);
  890.      FD[handle[0]].ftype := notty;
  891.      FD[handle[1]].ftype := notty;
  892.      RETURN(0);
  893.    ELSE
  894.      e.errno := res;
  895.      RETURN(-1);
  896.    END;
  897.  ELSE
  898.    e.errno := e.ENOSYS;
  899.    RETURN(-1);
  900.  END;
  901. END pipe;
  902.  
  903. (*---------------------------------------------------------------------------*)
  904.  
  905. PROCEDURE MiNTstat (    hndl : BOOLEAN;
  906.                         sym  : BOOLEAN;
  907.                         h    : INTEGER;
  908.                         path : StrPtr;
  909.                     VAR st   : StatRec ): INTEGER;
  910.  
  911. VAR
  912.   lres  : SIGNEDLONG;
  913.   done  : BOOLEAN;
  914.   dlen  : INTEGER;
  915.   xlen  : INTEGER;
  916.   xattr : XATTR;
  917.   tc    : timeCast;
  918.   pre   : ARRAY [0..10] OF CHAR;
  919.   (* Es reicht, die ersten Zeichen des DOS-Pfades zu kennen, um zu
  920.      berechnen, wieviele Zeichen laenger oder kuerzer der *IX-Pfad ist,
  921.      da "DosToUnix()" nur am Beginn des Pfades Laengen-Veraenderungen
  922.      vornimmt. Dadurch gibt es keine Begrenzung der Pfadlaenge auch ohne
  923.      dass deswegen ein riesiger Puffer bereitgestellt werden muss.
  924.    *)
  925. BEGIN
  926.  IF hndl THEN
  927.    done := Fcntl(h, ADR(xattr), FSTAT, lres);
  928.    h    := INT(lres);
  929.  ELSE
  930.    done := Fxattr(ORD(sym), path, ADR(xattr), h);
  931.    IF sym AND done AND (xattr.mode * sIFMT = sIFLNK) THEN
  932.      done := Freadlink(10, ADR(pre), path, h) OR (h = e.eRANGE);
  933.      (* eRANGE bedeutet nur, dass das ungekuerzte Ergebnis laenger als 10
  934.       * Zeichen waere, aber das interessiert hier nicht.
  935.       *)
  936.      IF done THEN
  937.        DosToUnix(CAST(StrPtr,ADR(pre)),
  938.                  0, CAST(StrPtr,ADR(pre)),
  939.                  dlen,
  940.                  xlen);
  941.        INC(xattr.size, VAL(SIGNEDLONG,xlen - dlen));
  942.      END;
  943.    END;
  944.  END;
  945.  IF NOT done THEN
  946.    e.errno := h;
  947.    RETURN(-1);
  948.  END;
  949.  
  950.  WITH st DO WITH xattr DO
  951.    stMode  := mode;
  952.    stIno   := index;
  953.    stDev   := dev;
  954.    stNlink := nlink;
  955.    stUid   := uid;
  956.    stGid   := gid;
  957.    stSize  := size;
  958.    tc.time := mtime;
  959.    tc.date := mdate;
  960.    stMtime := tc.cmp;
  961.    tc.time := atime;
  962.    tc.date := adate;
  963.    stAtime := tc.cmp;
  964.    tc.time := ctime;
  965.    tc.date := cdate;
  966.    stCtime := tc.cmp;
  967.  END; END;
  968.  RETURN(0);
  969. END MiNTstat;
  970.  
  971. (*--------------------------------------------------------------------------*)
  972.  
  973. PROCEDURE istat (VAR name : ARRAY OF CHAR;
  974.                  VAR st   : StatRec;
  975.                      sym  : BOOLEAN       ): INTEGER;
  976.  
  977. CONST DIRSIZE = 1024;
  978.  
  979. VAR         dta    : DTA;
  980.             err    : INTEGER;
  981.     __REG__ pLen   : UNSIGNEDWORD;
  982.             ROOT   : BOOLEAN;
  983.             DOT    : BOOLEAN;
  984.             drv    : BOOLEAN;
  985.             stack  : ADDRESS;
  986.             msize  : CARDINAL;
  987.             path0  : StrPtr;
  988.             tc     : timeCast;
  989.  
  990. BEGIN
  991.  msize := SLEN(name) + DINCR + 4; (* + 4 wegen ++ "\*.*" *)
  992.  memalloc(VAL(sizeT,msize), stack, path0);
  993.  UnixToDos(name, msize - DINCR - 4, VAL(StrRange,msize), path0, DOT, drv);
  994.  IF NOT drv THEN
  995.    memdealloc(stack);
  996.    RETURN(-1);
  997.  END;
  998.  
  999.  IF MiNT THEN
  1000.    err := MiNTstat(FALSE, sym, 0, path0, st);
  1001.    memdealloc(stack);
  1002.    RETURN(err);
  1003.  END;
  1004.  pLen := VAL(UNSIGNEDWORD,strlen(path0));
  1005.  
  1006.  st.stUid := 0;
  1007.  st.stGid := 0;
  1008.  
  1009.  IF IsDosDevice(path0) THEN
  1010.    WITH st DO
  1011.      stIno   := VAL(inoT,INODE); INC(INODE);
  1012.      stMode  := sIFCHR + STDPERM;
  1013.      stDev   := 0;
  1014.      tc.time := Tgettime();
  1015.      tc.date := Tgetdate();
  1016.      stMtime := tc.cmp;
  1017.      stAtime := tc.cmp;
  1018.      stCtime := tc.cmp;
  1019.      stNlink := 1;
  1020.      stSize  := 0;
  1021.    END;
  1022.    memdealloc(stack);
  1023.    RETURN(0);
  1024.  END;
  1025.  
  1026.  IF path0^[1] = DDRVPOSTFIX THEN
  1027.    st.stDev := VAL(devT,tocard(path0^[0]) - 10);
  1028.    drv      := TRUE;
  1029.  ELSE
  1030.    st.stDev := VAL(devT,Dgetdrv());
  1031.    drv      := FALSE;
  1032.  END;
  1033.  
  1034.  (* Hauptverzeichnisse muessen gesondert behandelt werden, da sie nicht
  1035.   * wie Unterverzeichnisse in der Baumstruktur eingebunden sind - sie
  1036.   * haben kein Erstellungsdatum und besitzen nicht die Eintraege
  1037.   * "." und ".." zur Verkettung.
  1038.   *)
  1039.  IF            (pLen = 1) AND (path0^[0] = DDIRSEP)
  1040.     OR drv AND (pLen = 3) AND (path0^[2] = DDIRSEP)
  1041.  THEN
  1042.    (* Ein Hauptverzeichnis ist direkt angegeben, deshalb sind keine
  1043.     * weiteren Tests noetig.
  1044.     *)
  1045.    ROOT := TRUE;
  1046.  ELSE
  1047.    IF path0^[pLen-1] = DDIRSEP THEN
  1048.      (* Verzeichnisse nicht extra kennzeichnen.
  1049.       * 'pLen' ist mindestens zwei, da der Fall 'pLen' = 1
  1050.       * oben abgefangen wird.
  1051.       *)
  1052.      path0^[pLen-1] := 0C;
  1053.      DEC(pLen);
  1054.    ELSIF drv AND (pLen = 2) THEN
  1055.      (* "Fsfirst("x:")" funktioniert nicht *)
  1056.      path0^[2] := '.';
  1057.      path0^[3] := 0C;
  1058.      DOT       := TRUE;
  1059.      INC(pLen);
  1060.    END;
  1061.  
  1062.    IF DOT THEN
  1063.      AssignM2ToC("\*.*", msize - VAL(CARDINAL,pLen), ADDADR(path0, pLen));
  1064.      (* Den ersten Eintrag suchen, sodass bei allen Verzeichnissen - ausser
  1065.       * den Hauptverzeichnissen - der Eintrag "." gefunden wird.
  1066.       * (Bei "..\*.*" wird das "." des uebergeordneten Verzeichnisses
  1067.       * gefunden.)
  1068.       *)
  1069.    END;
  1070.  
  1071.    IF FindFirst(path0, FINDALL, dta, err) THEN
  1072.      ROOT := DOT AND ((dta.name[0] <> '.') OR (dta.name[1] <> 0C));
  1073.      (* nicht-leeres Hauptverzeichnis, falls der erste Eintrag nicht
  1074.       * mit einem Punkt beginnt (normaler Dateiname), oder nach dem Punkt
  1075.       * nicht beendet ist (dann kann es nicht "." sein, das in allen
  1076.       * Verzeichnissen zuerst steht.
  1077.       *)
  1078.    ELSE
  1079.      (* Wenn kein Eintrag gefunden wird und "." oder ".." angegeben
  1080.       * wurden, handelt es sich um ein leeres Hauptverzeichnis,
  1081.       * ansonsten ist ein Fehler aufgetreten (angegebene Datei wurde
  1082.       * nicht gefunden).
  1083.       *)
  1084.      IF DOT AND (err = e.eFILNF) THEN
  1085.        ROOT := TRUE;
  1086.      ELSE
  1087.        e.errno := err;
  1088.        memdealloc(stack);
  1089.        RETURN(-1);
  1090.      END;
  1091.    END;
  1092.  END;
  1093.  
  1094.  IF ROOT THEN
  1095.    (* Einem Hauptverzeichnis lassen sich leider kaum Informationen
  1096.     * entlocken.
  1097.     *)
  1098.    WITH st DO
  1099.      stIno   := 2;
  1100.      stSize  := DIRSIZE;
  1101.      stNlink := 2;
  1102.      stMode  := sIFDIR + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  1103.      stMtime := 0;
  1104.      stAtime := 0;
  1105.      stCtime := 0;
  1106.    END;
  1107.    memdealloc(stack);
  1108.    RETURN(0);
  1109.  END;
  1110.  
  1111.  WITH st DO
  1112.    stIno   := VAL(inoT,INODE); INC(INODE);
  1113.    tc.date := dta.date;
  1114.    tc.time := dta.time;
  1115.    stMtime := tc.cmp;
  1116.    stAtime := tc.cmp;
  1117.    stCtime := tc.cmp;
  1118.    IF faSUBDIR IN dta.attr THEN
  1119.      stSize  := DIRSIZE;
  1120.      stNlink := 2;
  1121.    ELSE
  1122.      stSize  := dta.size;
  1123.      stNlink := 1;
  1124.    END;
  1125.    IF faSUBDIR IN dta.attr THEN
  1126.      stMode := sIFDIR + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  1127.    ELSIF IsExec(path0) THEN
  1128.      stMode := sIFREG + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  1129.    ELSE
  1130.      stMode := sIFREG + STDPERM;
  1131.    END;
  1132.    IF faRDONLY IN dta.attr THEN
  1133.      stMode := stMode - modeT{sIWUSR, sIWGRP, sIWOTH};
  1134.    END;
  1135.  END; (* WITH st *)
  1136.  memdealloc(stack);
  1137.  RETURN(0);
  1138. END istat;
  1139.  
  1140. (*--------------------------------------------------------------------------*)
  1141.  
  1142. PROCEDURE stat ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  1143.                 (* -- /AUS *) VAR st   : StatRec       ): INTEGER;
  1144.  
  1145. BEGIN
  1146.  RETURN(istat(file, st, FALSE));
  1147. END stat;
  1148.  
  1149. (*--------------------------------------------------------------------------*)
  1150.  
  1151. PROCEDURE lstat ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  1152.                  (* -- /AUS *) VAR st   : StatRec       ): INTEGER;
  1153.  
  1154. BEGIN
  1155.  RETURN(istat(file, st, TRUE));
  1156. END lstat;
  1157.  
  1158. (*--------------------------------------------------------------------------*)
  1159.  
  1160. PROCEDURE fstat ((* EIN/ -- *)     h  : INTEGER;
  1161.                  (* -- /AUS *) VAR st : StatRec  ): INTEGER;
  1162.  
  1163. VAR         err    : INTEGER;
  1164.             pos    : SIGNEDLONG;
  1165.             size   : SIGNEDLONG;
  1166.     __REG__ void   : BOOLEAN;
  1167.             time   : ARRAY [0..1] OF WORDSET;
  1168.             lres   : SIGNEDLONG;
  1169.             magic  : UNSIGNEDWORD;
  1170.             dummy  : StrPtr;
  1171.             tc     : timeCast;
  1172.  
  1173. BEGIN
  1174.  IF MiNT THEN
  1175.    RETURN(MiNTstat(TRUE, FALSE, h, dummy, st));
  1176.  END;
  1177.  IF (h<MinHandle) OR (h>MaxHandle) THEN
  1178.    e.errno := e.EBADF;
  1179.    RETURN(-1);
  1180.  END;
  1181.  WITH FD[VAL(HandleRange,h)] DO
  1182.    IF ftype = unknown THEN
  1183.      IF IsTerm(h) THEN
  1184.        ftype := istty;
  1185.      ELSE
  1186.        ftype := notty;
  1187.      END;
  1188.    END;
  1189.  END;
  1190.  WITH st DO
  1191.    IF FD[VAL(HandleRange,h)].ftype = istty THEN
  1192.      stMode  := sIFCHR + STDPERM;
  1193.      stSize  := 0;
  1194.      tc.time := Tgettime();
  1195.      tc.date := Tgetdate();
  1196.    ELSE
  1197.      Fdatime(ADR(time), h, 0);
  1198.      tc.time := time[0];
  1199.      tc.date := time[1];
  1200.  
  1201.      IF Fseek(0, h, ORD(SeekCur), pos) THEN
  1202.        void   := Fseek(0, h, ORD(SeekEnd), size);
  1203.        stSize := size;
  1204.  
  1205.        void := Fseek(0, h, ORD(SeekSet), size);
  1206.        void := Fread(h, 2, ADR(magic), lres);
  1207.        IF (lres = LIC(2)) AND ((magic = 601AH) OR (magic = 2321H))(* #! *) THEN
  1208.          stMode := sIFREG + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  1209.        ELSE
  1210.          stMode := sIFREG + STDPERM;
  1211.        END;
  1212.        void := Fseek(pos, h, ORD(SeekSet), size);
  1213.      ELSE
  1214.        e.errno := e.EBADF;
  1215.        RETURN(-1);
  1216.      END;
  1217.    END;
  1218.  
  1219.    stMtime := tc.cmp;
  1220.    stAtime := tc.cmp;
  1221.    stCtime := tc.cmp;
  1222.    stUid   := 0;
  1223.    stGid   := 0;
  1224.    stDev   := VAL(devT,Dgetdrv());
  1225.    stNlink := 1;
  1226.    stIno   := VAL(inoT,INODE); INC(INODE);
  1227.  END; (* WITH *)
  1228.  RETURN(0);
  1229. END fstat;
  1230.  
  1231. (*--------------------------------------------------------------------------*)
  1232.  
  1233. PROCEDURE sISCHR ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1234. BEGIN
  1235.  RETURN(stMode * sIFMT = sIFCHR);
  1236. END sISCHR;
  1237.  
  1238. (*--------------------------------------------------------------------------*)
  1239.  
  1240. PROCEDURE sISDIR ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1241. BEGIN
  1242.  RETURN(stMode * sIFMT = sIFDIR);
  1243. END sISDIR;
  1244.  
  1245. (*--------------------------------------------------------------------------*)
  1246.  
  1247. PROCEDURE sISBLK ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1248. BEGIN
  1249.  RETURN(stMode * sIFMT = sIFBLK);
  1250. END sISBLK;
  1251.  
  1252. (*--------------------------------------------------------------------------*)
  1253.  
  1254. PROCEDURE sISREG ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1255. BEGIN
  1256.  RETURN(stMode * sIFMT = sIFREG);
  1257. END sISREG;
  1258.  
  1259. (*--------------------------------------------------------------------------*)
  1260.  
  1261. PROCEDURE sISFIFO ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1262. BEGIN
  1263.  RETURN(stMode * sIFMT = sIFIFO);
  1264. END sISFIFO;
  1265.  
  1266. (*--------------------------------------------------------------------------*)
  1267.  
  1268. PROCEDURE sISLNK ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1269. BEGIN
  1270.  RETURN(stMode * sIFMT = sIFLNK);
  1271. END sISLNK;
  1272.  
  1273. (*--------------------------------------------------------------------------*)
  1274.  
  1275. PROCEDURE access ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  1276.                   (* EIN/ -- *)     acc  : AccessMode    ): INTEGER;
  1277.  
  1278. VAR dta : DTA;
  1279.     st  : StatRec;
  1280.  
  1281. BEGIN
  1282.  IF istat(file, st, FALSE) < 0 THEN
  1283.    RETURN(-1);
  1284.  ELSIF acc = fOK THEN
  1285.    RETURN(0);
  1286.  END;
  1287.  
  1288.  IF NOT MiNT OR (Pgetuid() = st.stUid) THEN
  1289.    IF acc <= CAST(AccessMode,VAL(UNSIGNEDWORD,
  1290.                CAST(UNSIGNEDWORD,st.stMode * sIRWXU) DIV 64))
  1291.    THEN
  1292.      RETURN(0);
  1293.    ELSE
  1294.      e.errno := e.EACCES;
  1295.      RETURN(-1);
  1296.    END;
  1297.  END;
  1298.  
  1299.  IF Pgetgid() = st.stGid THEN
  1300.    IF acc <= CAST(AccessMode,VAL(UNSIGNEDWORD,
  1301.                CAST(UNSIGNEDWORD,st.stMode * sIRWXG) DIV 8))
  1302.    THEN
  1303.      RETURN(0);
  1304.    ELSE
  1305.      e.errno := e.EACCES;
  1306.      RETURN(-1);
  1307.    END;
  1308.  END;
  1309.  
  1310.  IF acc <= CAST(AccessMode,st.stMode * sIRWXO) THEN
  1311.    RETURN(0);
  1312.  ELSE
  1313.    e.errno := e.EACCES;
  1314.    RETURN(-1);
  1315.  END;
  1316. END access;
  1317.  
  1318. (*==========================================================================*)
  1319.  
  1320. VAR
  1321.   i   : CARDINAL;
  1322.   old : WORDSET;
  1323.  
  1324. BEGIN (* file *)
  1325.  FOR i := 0 TO LBLKSIZE - 1 DO
  1326.    zerofill[i] := 0;
  1327.  END;
  1328.  
  1329.  DOSVersion := DosVersion();
  1330.  MiNT := MiNTVersion() > 0;
  1331.  IF MiNT THEN
  1332.    UMASK := CAST(modeT,Pumask(0));
  1333.    old   := Pumask(UMASK);
  1334.  ELSE
  1335.    UMASK := modeT{};
  1336.  END;
  1337. END file.
  1338.